COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00005 00003
C00008 00004
C00013 00005
C00015 00006
C00018 00007
C00022 00008
C00024 00009
C00026 00010
C00028 00011
C00031 00012
C00034 00013
C00037 00014
C00038 00015
C00040 ENDMK
C⊗;

TITLE ASSEMBLE LISP SYSTEM [UPDATED JULY 1, 1976 AND LATER]


;STRANGE FORMATS FOR BYTE POINTERS
.FORMAT 36,300636060000		; BYTPOS,BYTSIZ,  [ 1,7, = 010700,, ]
.FORMAT 37,002230063606		; BYTPOS,BYTSIZ,ADDRESS  [ 1,7,23 = 010700,,23 ]

DEFINE INFORM CRUFT1,CRUFT2,CRUFT3,CRUFT4
IF1,[PRINTC \
CRUFT1!CRUFT2!CRUFT3!CRUFT4
\
]
TERMIN

DEFINE TYO X/
IRP Q,,[X]
	.IOT TYOC,[Q]
TERMIN
TERMIN

DEFINE ALLOCATE ITEMS,XMIN,XMAX,LIST
N!ITEMS==XMIN
IRP QQQ,,[LIST]
IFSE ITEMS,ACS, QQQ=N!ITEMS
IFSE ITEMS,UUOS, QQQ=N!ITEMS←33
IFSN ITEMS,ACS, IFSN ITEMS,UUOS, QQQ==N!ITEMS
N!ITEMS==N!ITEMS+1
TERMIN
IFG N!ITEMS-XMAX, INFORM \N!ITEMS,[IS TOO MANY ITEMS (MAX = ]\XMAX,[)]
TERMIN

ALLOCATE ACS,1,17,[A,B,C,D,E,T,TT,UUOT,UUOTT,AIFLAG,QUESFL,NCRFFL,JCLBP]
ALLOCATE UUOS,1,37,[STRT,ASK,SHOVE,DECBP]
ALLOCATE IOCHS,1,17,[TYIC,TYOC,CFC,DSKC]

JUMPAI=JUMPN AIFLAG,	;JUMP IF AI
JUMPML=JUMPE AIFLAG,	;JUMP IF MATHLAB
JUMPQ=JUMPN QUESFL,	;JUMP IF WANT QUESTIONS
JUMPNQ=JUMPE QUESFL,	;JUMP IF NOT WANT QUESTIONS
JUMPNC=JUMPN NCRFFL,	;JUMP IF NOT WANT CREF
JUMPC=JUMPE NCRFFL,	;JUMP IF WANT CREF
JUMPJ=JUMPN JCLBP,	;JUMP IF HAVE JCL
JUMPNJ=JUMPE JCLBP,	;JUMP IF NOT HAVE JCL

FIRSTLOC:
LOC 41
	JSR UUOH		;TO HAIRY UUO HANDLER
LOC FIRSTLOC
UUOH:	0
	JRST UUOH0

DDTSTF:	ASCII \↔≠LSYS:TS  MIDAS
O∀TTY:,DSK:LISP;LSPTTY \
P3:	BLOCK 2
	ASCII \
I∀TTY:,CLU:LISP;MIDAS   \
P5:	BLOCK 2
	ASCII \    
\
MASCOM:	BLOCK 3
	ASCIZ \:EXISTS DSK:LISP;
:GZP
≠J⊗≠≠V\
;;; THE :EXISTS...
;;; IS TO RESET DDT'S PRINT DEFAULTS AND THEN
;;; FLUSH THE VALUE OF THE :EXISTS

CRSTUF:	ASCII \,DSK: LISP; BBCREF  \
P4:	BLOCK 2

LSSTUF:	ASCII \  ,  \
LCSTUF:	ASCII \,,DSK: LISP; LIST   \
P2:	BLOCK 2
	ASCII \     \

COMM:	ASCII \DSK: LISP;\
PC1:	ASCII \ BBLISP   \
P1:	BLOCK 2
CRFCOM:	BLOCK 6
LSTCOM:	BLOCK 7
	ASCII \←DSK:\
DIRNAM:	ASCII \ LISP\
	ASCII \;    \
LSPNAM:	ASCII \LISP \
	ASCII \     \
P0:	BLOCK 2
	ASCIZ \(R)\

LSTWRD:	ASCIZ \WWWXXX,,YYYZZZ\

DSKOPN:	SIXBIT \   DSKLISP  \
DSKFNM:	BLOCK 1

DTHOPN:	SIXBIT \   DSK*LISP \
DTHFNM:	BLOCK 1

LOSMSG:	SIXBIT \←DSK:↑LISP;↑LISP↑\
LOSFNM:	BLOCK 1
	SIXBIT \↑↑↑FILE↑NOT↑FOUND!\

CLOOPN:	SIXBIT \  !CLOMIDAS \
CLOFNM:	BLOCK 1

CLUOPN:	SIXBIT \   CLUMIDAS \
CLUFNM:	BLOCK 1

CLXOPN:	SIXBIT \  !CLUMIDAS \
CLXFNM:	BLOCK 1

ASSMSG:	SIXBIT \←VERSION↑\
ASSFNM:	BLOCK 1
	SIXBIT \↑↑↑ALREADY↑BEING↑ASSEMBLED!\

IRP FILNAM,,[LSPTTY,BBLISP,BBCREF,CREF,LIST]NM,,[LTY,BBL,BBC,CRF,LST]F,,[T,B,C,K,L]
NM!FIL:	SIXBIT \   DSK!FILNAM\
NM!FNM:	BLOCK 1
	0			;FOR .FDELE
	0
F!LOSMS:	SIXBIT \←DSK:↑LISP;↑FILNAM↑\
F!LOSFN:	BLOCK 1
	SIXBIT \↑↑↑FILE↑ALREADY↑PRESENT!\
TERMIN

RDBK:	0		;SAVED BREAK CHAR FROM READ

TTYDSP:	0		;NON-ZERO => DISPLAY TTY

PATCH:	BLOCK 100		;MOBY PATCH AREA

JCLBF:			;JCLBF SAME AS CFCBF
CFCBF:	BLOCK 2000-.	;MOBY BUFFER FOR REDEFINITIONS
ECFCBF:
	INFORM [LENGTH OF REDEFINITIONS BUFFER = ]\ECFCBF-CFCBF

LOC 2000		;SEPARATE PAGE FOR PURE CODE

GO:	MOVEI T,401001
	.CBLK T,		;PURIFY TOP PAGE (FOR PROTECTION ONLY)
	.VALUE
	SETZ JCLBP,QUESFL
	.SUSET [.ROPTION,,T]
	TLNE T,20000		;NO DDT FOR SUPERIOR
	TLZN T,40000		;SKIP IF JCL
	JRST NOJCL
	.BREAK 12,[5,,JCLBF]
	.BREAK 12,[400005,,[0]]
	.SUSET [.SOPTION,,T]
	MOVE JCLBP,[1,7,JCLBF-1]
NOJCL:	.SUSET [.SSNAM,,[SIXBIT \LISP\]]
	.CALL MUMBLE
	.VALUE
	CAME AIFLAG,[SIXBIT \AI\]
	TDZA AIFLAG,AIFLAG
	MOVEI AIFLAG,1
	.OPEN TYIC,[0,,SIXBIT \   TTYASSLISINPUT \]
	.VALUE
	.OPEN TYOC,[21,,SIXBIT \   TTYASSLISOUTPUT\]
	.VALUE
	.CALL GETTTY
	.VALUE
REINIT:	JUMPJ RDJCL
	JUMPML MLHI
	STRT [SIXBIT \←AI!\]
	JRST .+2
MLHI:	STRT [SIXBIT \←ML!\]
	STRT [SIXBIT \↑ASSLISP.!\]
	STRT [<.FNAM2&-100>+'!]
RDFNAM:	SETZ JCLBP,
	SETO QUESFL,		;DEFAULT IS WANT QUESTIONS, NO CREF
RDFNM1:	STRT [SIXBIT \←*!\]
RDJCL:	SETO NCRFFL,
	JSP E,READ
	JUMPE TT,RDFNM1
	MOVE E,[ASCII \ BBLI\]	;INITIALIZE SOME LOCATIONS
	MOVEM E,PC1
	MOVE E,[ASCII \SP   \]
	MOVEM E,PC1+1
	MOVE E,[SIXBIT \BBLISP\]
	MOVEM E,BBLFIL+1
	MOVEM E,BLOSMS+2
IRP NM,,[LTY,BBL,BBC,CRF,LST,CLU,CLX,CLO]F,,[T,B,C,K,L,-,-,-]
	MOVEM TT,NM!FNM
IFSN F,-, MOVEM TT,F!LOSFN
TERMIN
IRPC X,,[12345]
	MOVEM C,P!X
	MOVEM D,P!X+1
TERMIN
	HLLZ A,TT
	HRRZ B,TT
	CAIE B,'D20
	CAIN B,'TNX
	JRST JONL0
	CAIE B,'CMU
	CAIN B,'REL
	JRST JONL0
	CAIE B,'D10
	CAIN B,'SAI
	JRST JONL0
	CAIE B,'RLQ
	CAIN B,'MSA
	 JRST JONL0
	CAIE B,'SAQ
	 CAIN B,'CMQ
	  JRST JONL0
	JRST JONL1

JONL0:	HRLI B,'REL		;FOR THE VARIOUS DEC10 VERSIONS, NAME
	MOVEM B,BBLFIL+1	;THE OUTPUT "RELD10 XXX"  OR "RELSAI XXX"
	MOVEM B,BLOSMS+2	;OR WHATEVER, INSTEAD OF BBLISP XXXD10
	MOVEM A,BBLFNM
	MOVEM A,BLOSFN
	MOVEI A,77777		;TRANSFER ASCII FOR THE 3 DIGITS TO T
	ANDCA A,C
	IORI A,20100		;ASCII FOR THE TWO SPACES
	MOVEM A,P1
	MOVE A,[ASCII \     \]
	MOVEM A,P1+1
	MOVE A,C
	ANDI A,77777
	IOR A,[ASCII \REL\]
	MOVEM A,PC1
	MOVEM D,PC1+1
JONL1:	.OPEN CFC,CLUOPN
	JRST .+2
	JRST CFDEL
	.OPEN CFC,CLXOPN
	JRST CFOPEN
	.CLOSE CFC,
	JRST CLULOS
CFDEL:	.CLOSE CFC,		;MUST CLOSE IN ORDER TO
	.FDELE CLUOPN		; FLUSH RANDOM CLU FILE
	JRST CLULOS
CFOPEN:	.OPEN CFC,CLOOPN
	.VALUE
	MOVE A,RDBK
	CAIN A,"←
	JRST 2NAMES
	TRZ TT,-1		;USE ONLY 3 CHARS
	TRZ C,77777		;CLEAR 15. BITS, LEAVING 21.
	TRO C,77777&<ASCII \     \>	;INSERT SPACES
	MOVE D,SPACES
	JRST 1NAME
2NAMES:	JSP E,READ
	JUMPE TT,DIR2
1NAME:	MOVEM TT,DSKFNM
	MOVEM C,P0
	MOVEM D,P0+1
	MOVE E,[ASCII \LISP \]
	MOVEM E,LSPNAM
	MOVE E,[ASCII \ LISP\]
	MOVEM E,DIRNAM
	.OPEN DSKC,DSKOPN
	JRST DSKLOS
DSKWIN:	MOVE T,[[ASCII \0/-1
.MASTE≠X  \],,MASCOM]
	CAIE A,↑M		;CR OR ↑S OR ↑C OR ↑X MEANS NO QUESTIONS
	CAIN A,↑S
	SETZ QUESFL,
	CAIE A,↑C		;↑C AND ↑X ADDITIONALLY MEAN CREF
	CAIN A,↑X
	SETZB QUESFL,NCRFFL
	CAIE A,↑M		;CARRIAGE RETURN
	CAIN A,33		; OR ALTMODE
	HRLI T,SPACES
	CAIN A,↑X		; OR ↑X
	HRLI T,SPACES		; MEANS NO MASTER MODE
	BLT T,MASCOM+2

	MOVEI E,37
IRP %,,[LTY,BBL,BBC,CRF,LST]$,,[T,B,C,K,L]
	.OPEN DSKC,%!FIL
	TRZA E,1←.IRPCNT
	STRT $!LOSMS
TERMIN
	JUMPE E,NODLOS
DELP:	ASK A,[SIXBIT \←DELETE↑AND↑CONTINUE?:↑!\]
	.BREAK 16,40000
	CAIE A,"Y
	CAIN A,171		;SMALL Y
	JRST DELDEL
	STRT [SIXBIT \←>>>↑Y=YES,↑N=NO!\]
	JRST DELP
DELDEL:
IRP %,,[LTY,BBL,BBC,CRF,LST]
	TRNN E,1←.IRPCNT
	JRST .+3
	.FDELE %!FIL
	.VALUE
TERMIN
NODLOS:	MOVEI T,1
	JUMPC GLSCRF		;MAYBE CREF ALREADY SPECIFIED
	SETZ T,
	JUMPNQ GLSCR		;MAYBE DON'T WANT CREF QUESTION
	JRST CRFASK
WISGUY:	STRT [SIXBIT \←>>>↑C=CREF,↑L=LIST,↑N=NEITHER,↑B=BOTH!\]
CRFASK:	ASK A,[SIXBIT \←CREF/LIST?:↑!\]	;ASK IF CREF OR LIST IS WANTED
	JRST GLSCR
IRP X,,[0,40]
IRPC Q,,[CLB]
	CAIN A,X+"Q
	MOVEI T,1+.IRPCNT
TERMIN
TERMIN
	JUMPE T,WISGUY		;SOME WISE GUY IS GIVING BAD REPLIES!
	JRST GLSCR

GLSCRF:	STRT [SIXBIT \←;CREF!\]
GLSCR:	MOVE A,CRFTBL(T)
	MOVE B,LSTTBL(T)
	BLT A,CRFCOM+5
	BLT B,LSTCOM+6
	SHOVE COMM		;TRANSFER MIDAS COMMAND STRING TO CORE LINK FILE
	.IOT CFC,[↑M]		;CARRIAGE RETURN
	TRNN T,2		;SKIP IF WE WANT A LISTING
	JRST MLP

	SETZB C,E		;E HOLDS CONDITION BITS
	MOVEI D,FOOTBL		;D HAS TABLE POINTER
FOOASK:	ASK A,@(D)		;INQUIRE ABOUT A GIVEN SECTION
	JRST FOONO		;DON'T WANT IT
	CAIE A,"Y
	CAIN A,171		;SMALL Y
	JRST FOOYES		;WANT IT
	HLRZ B,2(D)		;DOES IT HAVE SUBSECTIONS?
	CAILE B,(C)
	JRST FOOSP		;YES
	STRT [SIXBIT \←>>>↑Y=YES,↑N=NO!\]
	JRST FOOASK		;ELSE GO TRY AGAIN
FOOSP:	CAIE A,"S
	CAIN A,163		;SMALL S
	JRST FOOSEL		;WANT SELECTION
	STRT [SIXBIT \←>>>↑Y=YES,↑N=NO,↑S=SELECT!\]
	JRST FOOASK		;ILLEGAL ANSWER, TRY AGAIN
FOOSEL:	ADDI C,1000		;INCREMENT LEVEL OF INQUIRY
	ADDI D,2		;INCREMENT TABLE POINTER
	JRST FOOASK
FOONO:	ADDI D,2		;INCREMENT TABLE POINTER
	HLRZ B,(D)
	CAILE B,(C)		;SKIP IF AT END OF SUBBLOCK
	JRST FOONO
	MOVEI C,(B)		;POP LEVEL BACK
	JUMPN B,FOOASK		;GO BACK IF ANY MORE
	JRST FOOCNV		;ELSE GO DO HAIRY STUFF
FOOYS0:	IOR E,1(D)		;OR IN BIT FOR THIS SECTION
FOOYES:	ADDI D,2		;INCREMENT TABLE POINTER
	HLRZ B,(D)
	CAILE B,(C)		;SKIP IF AT END OF SUBBLOCK
	JRST FOOYS0
	MOVEI C,(B)		;POP LEVEL BACK
	JUMPN B,FOOASK		;GO BACK IF ANY MORE
FOOCNV:	MOVEI A,14
	MOVE B,[440700,,LSTWRD]
FOOCN1:	SETZ D,			;CONVERT BITS TO 12.-DIGIT OCTAL
	LSHC D,3
	ADDI D,"0
	IDPB D,B
	CAIE A,7
	JRST FOOCN2
	MOVEI D,",		;OUTPUT TWO COMMAS BETWEEN HALFWORDS
	IDPB D,B
	IDPB D,B
FOOCN2:	SOJG A,FOOCN1
	SHOVE LSTW1		;SHOVE OUT GARBAGE
	SHOVE LSTWRD
	SHOVE LSTW2
	SHOVE LSTWRD
	SHOVE LSTW3

MLP:	JUMPAI GLS1
	SHOVE MLSTUF		;IF THIS IS MATHLAB, WE MUST TELL MIDAS
GLS1:	HRRZ T,LTYFNM		;CHECK OUT SECOND FILE NAME
	JUMPN T,XXXNUL
	STRT [SIXBIT \←ITS==1!\]
	SHOVE NULSTF
	JRST XXXGLS
XXXNUL:	CAIE T,'QIO
	 JRST XXXQIO
	STRT [SIXBIT \←ITS==1←QIO==1←SFA==1!\]
	SHOVE QIOSTF
	JRST XXXGLS
XXXQIO:	CAIE T,'REL
	 JRST XXXREL
	STRT [SIXBIT \←TOPS10==1!\]
	SHOVE RELSTF
	JRST XXXGLS
XXXREL:	CAIE T,'RLQ
	 JRST XXXRLQ
	STRT [SIXBIT \←TOPS10==1←QIO==1!\]
	SHOVE RLQSTF
	JRST XXXGLS
XXXRLQ:	CAIE T,'SAQ
	 JRST XXXSAQ
	STRT [SIXBIT \←SAIL==1←EDFLAG==0←QIO==1!\]
	SHOVE SAQSTF
	JRST XXXGLS
XXXSAQ:	CAIE T,'CMQ
	 JRST XXXCMQ
	STRT [SIXBIT \←CMU==1←QIO==1!\]
	SHOVE CMQSTF
	JRST XXXGLS
XXXCMQ:	CAIE T,'D20
	 JRST XXXD20
	STRT [SIXBIT \←TOPS20==1←QIO==1←SFA==1!\]
	SHOVE D20STF
	JRST XXXGLS
XXXD20:	CAIE T,'TNX
	 JRST XXXTNX
	STRT [SIXBIT \←TENEX==1!\]
	SHOVE TNXSTF
	JRST XXXGLS
XXXTNX:	CAIE T,'CMU
	 JRST XXXCMU
	STRT [SIXBIT \←CMU==1!\]
	SHOVE CMUSTF
	JRST XXXGLS
XXXCMU:	CAIE T,'D10
	 JRST XXXD10
	STRT [SIXBIT \←TOPS10==1←EDFLAG==0←USELESS==0←BIGNUM==0←HNKLOG==0←OBTSIZ==377!\]
	SHOVE RELSTF
	SHOVE D10STF
	JRST XXXGLS
XXXD10:	CAIE T,'MSA
	 JRST XXXMSA
	STRT [SIXBIT \←SAIL==1←EDFLAG==0←USELESS==0←BIGNUM==0←FUNAFL=0!\]
	SHOVE SAISTF
	SHOVE MSASTF
	JRST XXXGLS
XXXMSA:	CAIE T,'SAI
	 JRST XXXSAI
	STRT [SIXBIT \←SAIL==1←EDFLAG==0!\]
	SHOVE SAISTF
XXXSAI:
XXXGLS:	JUMPNQ NORDF		;MAYBE DON'T WANT REDEF QUESTION
RDFMSG:	STRT [SIXBIT \←REDEFINITIONS:←!\]
	SETZM CFCBF		;ALLOW INPUT OF OTHER REDEFINITIONS
	MOVE T,[CFCBF,,CFCBF+1]	; FOR MIDAS .INSRT TTY:
	BLT T,ECFCBF-1
	MOVE T,[1,7,CFCBF-1]
GLS2:	JSP E,GETCHR		;READ FIRST CHAR OF LINE
	CAIN A,↑M		;CR MEANS A NEW LINE AGAIN ALREADY
	 JRST GLS2
	CAIE A,↑C
	JRST GLS2
	MOVEI A,0		;ERASE ↑C WITH A NULL
	DPB A,T
	SHOVE CFCBF		;MOVE STUFF OUT TO CORE LINK DEVICE
	SHOVE [ASCIZ \PRINTC ≤\]
	SHOVE CFCBF		;ONCE MORE, SO IT APPEARS ON THE LSPTTY FILE
	SHOVE [ASCIZ \≤
\]
NORDF:	.IOT CFC,[↑C]		;OUTPUT CONTROL C
	.CLOSE CFC,
	STRT [SIXBIT \←!\]
	.VALUE DDTSTF		;VALRET STRING TO DDT TO GET MIDAS RUNNING

DEFINE STUFIT STUFF
	ASCIZ ≤
PRINTC ≡STUFF
≡
STUFF
≤
TERMIN

MLSTUF:	STUFIT [ML==1]

NULSTF:	STUFIT [ITS==1]

RELSTF:	STUFIT [TOPS10==1]

RLQSTF:	STUFIT [TOPS10==1
QIO==1]

SAQSTF:	STUFIT [SAIL==1
EDFLAG==0
QIO==1]

CMQSTF:	STUFIT [CMU==1
QIO==1]

D20STF:	STUFIT [TOPS20==1
QIO==1
SFA==1]

TNXSTF:	STUFIT [TENEX==1]

CMUSTF:	STUFIT [CMU==1]

D10STF:	STUFIT [EDFLAG==0
USELESS==0
BIGNUM==0
HNKLOG==0
OBTSIZ==377]

MSASTF:	STUFIT [USELESS==0
BIGNUM==0
FUNAFL==0]

SAISTF:	STUFIT [SAIL==1
EDFLAG==0]

QIOSTF:	STUFIT [ITS==1
QIO==1
SFA==1]

SPACES:	REPEAT 7, ASCII \     \		;FIVE SPACES

LSTW1:	ASCIZ \
PRINTC /
$LIST$==<\
LSTW2:	ASCIZ \>	;LISTING CONTROL
/
$LIST$==<\
LSTW3:	ASCIZ \>
\

CRFTBL:	SPACES,,CRFCOM	;N
	CRSTUF,,CRFCOM	;C
	SPACES,,CRFCOM	;L
	CRSTUF,,CRFCOM	;B

LSTTBL:	SPACES,,LSTCOM	;N
	SPACES,,LSTCOM	;C
	LSSTUF,,LSTCOM	;L
	LCSTUF,,LSTCOM	;B

MUMBLE:	SETZ
	SIXBIT \SSTATU\
REPEAT 5, 2000,,AIFLAG
	402000,,AIFLAG

GETTTY:	SETZ
	SIXBIT \TTYGET\
	1000,,TYIC
REPEAT 4,	2000,,A
	402000,,TTYDSP

DIR:	.OPEN DSKC,[0,,SIXBIT \   DSK.FILE.(DIR) \]
	.VALUE
	JSP A,CLRTTY		;CLEAR TTY SCREEN
DIR1:	.IOT DSKC,A		;PRINT LISP DIRECTORY
	CAIN A,↑L
	JRST DIR2
	.IOT TYOC,A
	JRST DIR1
DIR2:	TYO ↑G
	JRST RDFNAM

DSKLOS:	MOVE E,[ASCII \*LISP\]
	MOVEM E,LSPNAM
	MOVEM TT,DTHFNM
	.OPEN DSKC,DTHOPN
	JRST DTHLOS
	STRT [SIXBIT \←[*LISP]!\]
	JRST DSKWIN

DTHLOS:	MOVEM TT,LOSFNM		;DISK FILE NONEXISTENT - CAN'T ASSEMBLE A PHANTOM PHILE
	STRT LOSMSG
	JRST RDFNAM

CLULOS:	MOVEM TT,ASSFNM		;APPARENTLY SOMEBODY'S ASSEMBLING
	STRT ASSMSG		; THIS VERSION ALREADY
	JRST RDFNAM

CLRTTY:	TYO ↑M,↑J
CLRTT1:	SKIPN TTYDSP		;ALTERNATE ENTRY
	JRST (A)		;CAN'T CLEAR SCREEN IF PRINTING TTY
	TYO ↑P,"C
	JRST (A)

READ:	MOVE C,SPACES		;READ FILE NAME:
	MOVE D,SPACES		; LEAVE ASCII IN C AND D
	SETZ TT,		; LEAVE SIXBIT IN TT
	MOVE T,[0,6,TT-1]	; LEAVE EXTRA CHAR IN A
	MOVE B,[0,7,C-1]	; USES B AND T
	JRST READ1		; RETURNS THROUGH E

READ0:	CAMN T,[0,6,TT]
	JRST READ1
	IDPB A,B
	SUBI A,40
	IDPB A,T
READ1:	JUMPJ READ9
	.IOT TYIC,A
	JUMPE A,.-1
	CAIN A,↑G
	JRST REINIT
	CAIN A,↑F
	JRST DIR
READ1A:	CAIG A,40+"Z
	CAIGE A,40+"A
	JRST READ2
	SUBI A,40
	JRST READ0

READ9:	ILDB A,JCLBP
	JUMPN A,READ1A
	MOVEI A,↑M
	JRST READ1A

READ2:	CAIG A,"↑
	CAIGE A,"!
	JRST READ4
	CAIN A,"!
	JRST READ6
	CAIN A,"#
	JRST READ6
	CAIE A,"↑
	JRST READ0
READ6:	TYO "?,"?,↑G
	JRST RDFNAM

READ4:	MOVEM A,RDBK
	CAIE A,177		;RUBOUT
	JRST (E)
	CAMN T,[0,6,TT-1]	;SKIP UNLESS ENTIRE NAME RUBBED OUT
	JRST RDFNAM		;START FROM SCRATCH
BACKUP:	LDB A,B			;ECHO RUBBED-OUT CHARACTER
	.IOT TYOC,A
	MOVEI A,40		;REPLACE BY SPACE IN BUFFER
	DPB A,B
	SETZ A,
	DPB A,T
	DECBP B			;BACK UP BYTE POINTERS
	DECBP T
	JRST READ1

GETCH0:	CAMN T,[1,7,CFCBF-1]	;SKIP UNLESS ENTIRE BUFFER HAS BEEN RUBBED OUT
	JRST GLS1		;GO RE-PROMPT LOSER
	LDB A,T			;GET CHARACTER RUBBED OUT
	.IOT TYOC,A		; AND ECHO BACK AT LOSER
	SETZ A,
	DPB A,T			;ZERO CHAR JUST ECHOED
	DECBP T			;BACK UP POINTER
GETCHR:	.IOT TYIC,A		;INPUT A CHAR
	JUMPE A,.-1		;IGNORE NULL CHARS
	CAIN A,↑\		;↑\ LOSES BECAUSE OF PRINTC OUTPUT
	JRST GETCH1
GETCH2:	CAIE A,↑Q		;QUOTE CHARACTER
	JRST GETCH3
	.IOT TYIC,A
	JUMPE A,.-1		;IGNORE NULLS
	CAIN A,↑\		;↑\ LOSES
	JRST GETCH1
	CAIE A,↑C		;SO DOES ↑C
	JRST GETCH5
GETCH1:	.IOT TYOC,A		;ECHO IT BACK, PLUS A BELL
	TYO ↑G
	JRST GETCHR
GETCH3:	CAIE A,↑K		;SOFT FORM FEED
	CAIN A,↑L		;LOUD FORM FEED
	JRST GETCH7
	CAIN A,↑F
	JRST FLAGS
	CAIE A,↑G		;QUIT SIGNAL
	JRST GETCH4
	CAMN T,[1,7,CFCBF-1]	;KIND OF QUIT DEPENDS ON WHERE WE ARE
	JRST REINIT
	JRST GLS1		;MY APOLOGIES TO DIJKSTRA
GETCH4:	CAIN A,177		;SKIP UNLESS RUBOUT
	JRST GETCH0
GETCH5:	IDPB A,T		;DEPOSIT CHARACTER IN BUFFER
	MOVEI D,↑J
	CAIN A,↑M		;CARRIAGE RETURNS CAUSE INSERTION
	IDPB D,T		; OF FOLLOWING LINE FEED
	JRST (E)		;RETURN CHARACTER IN A
GETCH7:	CAIN A,↑L
	JSP A,CLRTT1
GETCH8:	STRT @RDFMSG
	SKIPA D,[1,7,CFCBF-1]
GETCH9:	.IOT TYOC,A		;ECHO BACK TOTAL CONTENTS OF BUFFER
	ILDB A,D
	JUMPN A,GETCH9
	JRST GETCHR

FLAGS:	JSP A,CLRTTY		;CLEAR TTY SCREEN
	.OPEN DSKC,DSKOPN	;OPEN LISP SOURCE FILE
	SKIPA
	JRST .+3
	.OPEN DSKC,DTHOPN
	.VALUE
	MOVEI D,3		;FLAGS-PER-LINE COUNTER
FLAGS1:	.IOT DSKC,A		;SEARCH FOR INITIAL "
	CAIE A,""
	JRST FLAGS1
FLAGS2:	.IOT DSKC,A		;SEARCH FOR LINE FEED OR FINAL "
	CAIN A,""
	JRST FLAGS5
	CAIE A,↑J
	JRST FLAGS2
	.IOT DSKC,A		;NEW LINE FOUND
	CAIG A,40		;DON'T WANT IT IF IT BEGINS WITH
	JRST FLAGS2		; A SPACE OR CTRL CHAR
	CAIN A,";		;DON'T WANT COMMENT LINES
	JRST FLAGS2
FLAGS4:	.IOT TYOC,A		;ECHO LINE UNTIL SPACE OR CTRL CHAR
	.IOT DSKC,A
	CAILE A,40
	JRST FLAGS4
	SOJE D,FLAGS3		;PRINT FLAGS THREE PER LINE
	TYO 40,40,40,↑I
	JRST FLAGS2
FLAGS3:	TYO ↑M,↑J
	MOVEI D,3		;RESET COUNTER
	JRST FLAGS2
FLAGS5:	CAIN D,3		;ALL DONE - MAYBE NEED CR/LF
	 JRST FLAGS6
	TYO ↑M,↑J
FLAGS6:	JUMPAI FLAGS8		;TWO MORE FLAGS FOR MATHLAB
	STRT [SIXBIT \ML==1←MOBIOF==0←!\]
FLAGS8:	HRRZ D,LTYFNM		;FIGURE OUT OTHER FLAGS
	SKIPN D
	 STRT [SIXBIT \←ITS==1!\]
	CAIN D,'QIO
	 STRT [SIXBIT \←ITS==1←QIO==1←SFA==1!\]
	CAIN D,'REL
	 STRT [SIXBIT \←TOPS10==1!\]
	CAIN D,'RLQ
	 STRT [SIXBIT \←TOPS10==1←QIO==1!\]
	CAIN D,'SAQ
	 STRT [SIXBIT \←SAIL==1←EDFLAG==0←QIO==1!\]
	CAIN D,'CMQ
	 STRT [SIXBIT \←CMU==1←QIO==1!\]
	CAIN D,'D20
	 STRT [SIXBIT \←TOPS20==1←QIO==1←SFA==1!\]
	CAIN D,'TNX
	 STRT [SIXBIT \←TENEX==1!\]
	CAIN D,'CMU
	 STRT [SIXBIT \←CMU==1!\]
	CAIN D,'D10
	 STRT [SIXBIT \←TOPS10==1←EDFLAG==0←USELESS==0←BIGNUM==0←HNKLOG==0←OBTSIZ==377!\]
	CAIN D,'MSA
	 STRT [SIXBIT \←SAIL==1←EDFLAG==0←USELESS==0←BIGNUM==0←FUNAFL==0!\]
	CAIN D,'SAI
	 STRT [SIXBIT \←SAIL==1←EDFLAG==0!\]
	JRST GETCH8

UUOH0:	LDB UUOT,[27.,9.,40]	;HAIRY UUO HANDLER
	CAILE UUOT,NUUOS	;WE ONLY KNOW ABOUT <NUUOS> FLAVORS OF UUO
	 .VALUE			;ANY OTHERS LOSE
	JRST @UUOTBL-1(UUOT)	;MINI-MOBY DISPATCH
UUORET=JRST 2,@UUOH		;THIS IS HOW TO RETURN FROM MINI-MOBY DISPATCH

UUOTBL:	%STRT		;STRING TYPEOUT
	%ASK		;ASK QUESTION, SKIP ON YES ANSWER
	%SHOVE		;SHOVE OUT ASCII FOR MIDAS
	%DECBP		;DECREMENT BYTE POINTER

%STRT:
%ASK:	HRRZ UUOTT,40
	HRLI UUOTT,(36.,6,)	;TYPEOUT OF A SIXBIT STRING
6TYP:	ILDB UUOT,UUOTT
	JUMPE UUOT,6TYP		;IGNORE SPACES
	CAIN UUOT,'↑		;↑ PRINTS AS SPACE
	JRST 6TYPSP
	CAIN UUOT,'#		;# QUOTES NEXT CHARACTER
	JRST 6TYP0
	CAIN UUOT,'!		;! ENDS TYPEOUT
	JRST ASKP
	CAIE UUOT,'←		;← OUTPUTS CR,LF
	JRST 6TYP1
	TYO ↑M,↑J
	JRST 6TYP
6TYPSP:	TDZA UUOT,UUOT
6TYP0:	ILDB UUOT,UUOTT
6TYP1:	ADDI UUOT,40
	.IOT TYOC,UUOT
	JRST 6TYP
ASKP:	LDB UUOT,[27.,9.,40]	;IS THIS ASK OR STRT?
	CAIE UUOT,ASK←-33
UUOXIT:	UUORET			;STRT
	.IOT TYIC,UUOTT		;ASK
	JUMPE UUOTT,.-1
	CAIE UUOTT,"N		;CAPITAL N
	CAIN UUOTT,156		;SMALL N
	JRST .+2
	AOS UUOH		;SKIP RETURN IF NOT N
	LDB UUOT,[23.,4,40]	;IF THE AC FIELD OF ASK IS NON-ZERO,
	JUMPE UUOT,.+2		; PLACE THE CHARACTER READ IN THAT AC
	MOVEM UUOTT,(UUOT)
	MOVEI UUOT,REINIT	;CONTROL G FORCES RESTART RETURN
	CAIN UUOTT,↑G
	HRRM UUOT,UUOH
	UUORET

%SHOVE:	HRRZ UUOTT,40		;SHOVE ASCII OUT TO CORE LINK DEVICE
	HRLI UUOTT,(44,7,)
7.CFC:	ILDB UUOT,UUOTT
	JUMPE UUOT,UUOXIT	;NULL CHAR TERMINATES
	.IOT CFC,UUOT
	JRST 7.CFC

%DECBP:	LDB UUOT,[24.,6,@40]	;DECREMENT BYTE POINTER
	MOVE UUOTT,UUOT		;BYTE SIZE
	ROT UUOT,-6
	ADDB UUOT,@40		;BACK UP POINTER BY PROPER NUMBER OF BITS
	LSH UUOT,-36
	CAIGE UUOT,44		;SKIP ON WORD BOUNDARY UNDERFLOW
	UUORET
	MOVE UUOT,DECTBL-6(UUOTT)
	EXCH UUOT,@40
	SUBM UUOT,@40
	UUORET

DECTBL:	44,0,1			;6 BIT BYTES
	43,0,1			;7 BIT BYTES

DEFINE FOO LEVEL,BITNO,MSG
	LEVEL←11,,[SIXBIT \←MSG?:↑!\]
ZZ==0
IFNB BITNO,[
IRPNC 0,2,-1,X,,[BITNO]
ZZ==11*ZZ+X-1
TERMIN
	1←ZZ
]
.ELSE 0
TERMIN

;;; THIS TABLE MUST CORRESPOND TO THE MOBY IRP
;;; IN LISP WHERE $LIST$ IS DEFINED

FOOTBL:			;GRIDIRON DATA
	FOO 0,---,TOTAL↑LISTING
	FOO 1,---,↑↑SYSTEM↑CODE
	FOO 2,4.9,↑↑↑↑LOW↑IMPURE
	FOO 2,4.8,↑↑↑↑ERROR↑PAGE
	FOO 2,4.7,↑↑↑↑BAKTRACE/FRAME
	FOO 2,4.6,↑↑↑↑MOBYIO
	FOO 2,2.2,↑↑↑↑SORT↑ROUTINES
	FOO 2,4.5,↑↑↑↑PRINT/UTAPE
	FOO 2,4.4,↑↑↑↑USEFUL↑SUBRS
	FOO 2,4.3,↑↑↑↑ARITHMETIC
	FOO 2,4.2,↑↑↑↑BIGNUM
	FOO 2,4.1,↑↑↑↑EVAL/APPLY
	FOO 2,3.9,↑↑↑↑GC/READTABLE
	FOO 2,3.8,↑↑↑↑READER/INTERN
	FOO 2,3.7,↑↑↑↑STATUS/EDITOR
	FOO 2,---,↑↑↑↑ARRAYS/LAP
	FOO 3,3.6,↑↑↑↑↑↑ARRAYS
	FOO 3,2.6,↑↑↑↑↑↑LAP
	FOO 3,2.5,↑↑↑↑↑↑OP-DECODER
	FOO 2,3.5,↑↑↑↑FASLOAD
	FOO 2,3.4,↑↑↑↑COMMON/INT/UUO
	FOO 1,---,↑↑LIST↑STRUCTURE
	FOO 2,3.3,↑↑↑↑MACROS
	FOO 2,3.2,↑↑↑↑INITIAL↑ATOMS
	FOO 2,3.1,↑↑↑↑FREE↑STORAGE
	FOO 2,2.9,↑↑↑↑NUMBER↑AREAS
	FOO 1,---,↑↑BIBOP↑TABLES
	FOO 2,2.8,↑↑↑↑SEGMENT↑TABLE
	FOO 2,2.4,↑↑↑↑GC↑SEGMENT↑TABLE
	FOO 2,2.3,↑↑↑↑PURE↑PAGE↑TABLE
	FOO 1,2.7,↑↑INIT/ALLOCATOR
	0	;END OF GRIDIRON DATA

BCONSTANTS:
CONSTANTS

INFORM [LENGTH OF PURE CODE = ]\.-2000

END GO
βββ